home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / GNODES.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  21KB  |  837 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* gnodes.c - translation of gnodes.stl */
  10.  
  11. #define GEN
  12.  
  13. #include "hdr.h"
  14. #include "vars.h"
  15. #include "gvars.h"
  16. #include "chapp.h"
  17. #include "gmiscp.h"
  18. #include "dbxp.h"
  19. #include "setp.h"
  20. #include "miscp.h"
  21. #include "smiscp.h"
  22. #include "chapp.h"
  23. #include "gutilp.h"
  24. #include "gnodesp.h"
  25.  
  26. /*
  27.  * Tree construction procedures
  28.  *--------------------
  29.  * 2. Lexical elements
  30.  */
  31.  
  32. Node new_number_node(int value)                                /*;new_number_node*/
  33. {
  34.     /* constructs an number node, used to hold small integer values used for
  35.      * attributes and return statement depth.
  36.      */
  37.  
  38.     Node    node;
  39.  
  40.     node        = node_new(as_number);
  41.     N_VAL (node) = (char *) value;
  42.     return node;
  43. }
  44.  
  45. Node new_instance_node(Tuple value)                        /*;new_instance_node*/
  46. {
  47.     /* constructs an instance node, used to hold tups used for instantiations */
  48.     Node    node;
  49.  
  50.     node        = node_new(as_instance_tuple);
  51.     N_VAL (node) = (char *) value;
  52.     return node;
  53. }
  54.  
  55. void make_ivalue_node(Node node, Const value, Symbol typ)  /*;make_ivalue_node*/
  56. {
  57.     /* constructs an ivalue node */
  58.  
  59.     int nk;
  60.  
  61.     nk = N_KIND(node);
  62.     if (N_AST1_DEFINED(nk)) N_AST1(node) = (Node) 0;
  63.     if (N_AST2_DEFINED(nk)) N_AST2(node) = (Node) 0;
  64.     if (N_AST3_DEFINED(nk)) N_AST3(node) = (Node) 0;
  65.     if (N_AST4_DEFINED(nk)) N_AST4(node) = (Node) 0;
  66.     if (N_LIST_DEFINED(nk)) N_LIST(node) = (Tuple) 0;
  67.     N_KIND(node) = as_ivalue;
  68.     N_VAL (node) = (char *) value;
  69.     N_TYPE(node) = typ;
  70. }
  71.  
  72. /*
  73.  *--------------------------
  74.  * 3.2.1 Object declarations
  75.  */
  76.  
  77. #ifndef BINDER
  78. void make_single_decl_list(Node root, Node decl_node) /*;make_single_decl_list*/
  79. {
  80.     /*
  81.      * This procedure transforms a declaration with a list of names into a
  82.      * list of declarations, each with one sigle name. It is called in the
  83.      * case of declarations with side-effect.
  84.      * This procedure is ineffective if the original name list has only one
  85.      * element.
  86.      * root is the root of the tree to duplicate, while decl_node points to
  87.      * the actual (original) declaration. The latter is part of the tree, but
  88.      * not necessarily the root due to possible pre-statements.
  89.      * The declaration is supposed to be fit for the first element of the
  90.      * list, so renaming is necessary for all others.
  91.      */
  92.  
  93.     Node        id_list_node, first_id, id;
  94.     Tuple    id_list, decl_list;
  95.     Symbol    first_name, first_type, id_name;
  96.     Fortup    ft1;
  97.     Symbolmap       rename_map;
  98.  
  99.     id_list_node = N_AST1(decl_node);
  100.     id_list        = tup_copy(N_LIST(id_list_node));
  101.     /* tup_copy needed since id_list used destructively in tup_fromb below*/
  102.     if (tup_size(id_list) == 1)
  103.         return;
  104.  
  105.     first_id         = (Node) tup_fromb(id_list);
  106.     N_LIST(id_list_node) = tup_new1((char *) first_id);
  107.     first_name           = N_UNQ  (first_id);
  108.     first_type           = TYPE_OF(first_name);
  109.     decl_list            = tup_new1((char *) copy_node(root));
  110.     FORTUP(id=(Node), id_list, ft1);
  111.         id_name       = N_UNQ(id);
  112.         /* RENAME_MAP    = {[first_name, id_name],
  113.            *          [first_type, TYPE_OF(id_name)] };
  114.            */
  115.         rename_map = symbolmap_new();
  116.         symbolmap_put(rename_map, first_name, id_name);
  117.         symbolmap_put(rename_map, first_type, TYPE_OF(id_name));
  118.         node_map = nodemap_new();    /* initialize */
  119.  
  120.         decl_list = tup_with(decl_list,
  121.           (char *) instantiate_tree(root, rename_map));
  122.     ENDFORTUP(ft1);
  123.  
  124.     N_KIND(root) = as_declarations;
  125.     N_AST1(root) = (Node)0; 
  126.     N_AST2(root) = (Node)0;
  127.     N_AST3(root) = (Node)0; 
  128.     N_AST4(root) = (Node)0;
  129.     N_LIST(root) = decl_list;
  130.     N_SIDE(root) = TRUE;  /* We are called only in case of side-effect */
  131. }
  132. #endif
  133.  
  134. void make_const_node(Node node, Symbol const_name, Symbol type_name,
  135.   Node init_node)                                        /*;make_const_node*/
  136. {
  137.     Node    list_node;
  138.  
  139.     list_node         = new_node(as_list);
  140.     N_KIND(node)      = as_const_decl;
  141.     N_LIST(list_node) = tup_new1((char *) new_name_node(const_name));
  142.     N_LIST(node)      = (Tuple) 0;
  143.     N_VAL (node)      = (char *) 0;
  144.     N_AST1(node)      = list_node ;
  145.     N_AST2(node)      = new_name_node(type_name) ;
  146.     N_AST3(node)      = init_node ;
  147. }
  148.  
  149. Node new_var_node(Symbol var_name, Symbol type_name, Node init_node)
  150.                                                             /*;new_var_node*/
  151. {
  152.     Node   list_node, node;
  153.  
  154.     list_node         = new_node(as_list);
  155.     N_LIST(list_node) = tup_new1((char *) new_name_node(var_name));
  156.     node              = new_node(as_obj_decl);
  157.     N_AST1(node)      = list_node ;
  158.     N_AST2(node)      = new_name_node(type_name) ;
  159.     N_AST3(node)      = init_node ;
  160.     return node;
  161. }
  162.  
  163. /*
  164.  *---------------------------
  165.  * 3.3.2 Subtype declarations
  166.  */
  167.  
  168. Node new_subtype_decl_node(Symbol type_name)        /*;new_subtype_decl_node*/
  169. {
  170.     /*
  171.      * Creates a subtype declaration node. Only type name initialized, as
  172.      * types are fully processed from the symbol table.
  173.      */
  174.     Node    node;
  175.  
  176.     node        = new_node(as_subtype_decl);
  177.     N_AST1(node) = new_name_node(type_name);
  178.     N_AST2(node) = OPT_NODE;
  179.     N_UNQ(node) = type_name;
  180.     return node;
  181. }
  182.  
  183. /*
  184.  *----------------
  185.  * 3.8 Access type
  186.  */
  187.  
  188. Node new_null_node(Symbol r_type)                            /*;new_null_node*/
  189. {
  190.     Node    node;
  191.  
  192.     node         = new_node(as_null) ;
  193.     N_TYPE(node) = r_type ;
  194.     return node ;
  195. }
  196.  
  197. /*
  198.  *----------
  199.  * 4.1 Names
  200.  */
  201.  
  202. Node new_name_node(Symbol name)                                /*;new_name_node*/
  203. {
  204.     /* constructs an as_simple_name node. */
  205.     Node    node;
  206.  
  207.     if (name == (Symbol)0)
  208.         compiler_error("Name is omega in new_name_node");
  209.     node         = new_node(as_simple_name);
  210.     N_UNQ (node) = name;
  211.     return node;
  212. }
  213.  
  214. void make_name_node(Node node, Symbol name)                /*;make_name_node*/
  215. {
  216.     /* Transforms node into an as_simple_name node. */
  217.  
  218.     if (name == (Symbol)0)
  219.         compiler_error("Name is omega in make_name_node");
  220.     N_KIND(node) = as_simple_name;
  221.     N_AST1(node) = (Node)0; 
  222.     N_AST2(node) = (Node) 0;
  223.     N_AST3(node) = (Node)0; 
  224.     N_AST4(node) = (Node) 0;
  225.     N_LIST(node) = (Tuple)0;
  226.     N_TYPE(node) = (Symbol) 0;
  227.     N_VAL (node) = (char *) 0;
  228.     N_UNQ (node) = name;
  229. }
  230.  
  231. /*
  232.  *--------------------------
  233.  * 4.1.1 Indexed components
  234.  */
  235.  
  236. Node new_index_node(Node object_node, Tuple index_list, Symbol comp_type)
  237.                                                             /*;new_index_node*/
  238. {
  239.     /* Build an as_index node */
  240.     Node    node, list_node;
  241.  
  242.     list_node         = new_node(as_list);
  243.     N_LIST(list_node) = index_list;
  244.     node              = new_node(as_index);
  245.     N_AST1(node)      = object_node ;
  246.     N_AST2(node)      = list_node ;
  247.     N_TYPE(node)      = comp_type;
  248.     return node;
  249. }
  250.  
  251. void make_index_node(Node node, Node object_node, Tuple index_list,
  252.   Symbol comp_type)                                        /*;make_index_node */
  253. {
  254.     /* Build an as_index node */
  255.     Node    list_node;
  256.  
  257.     list_node         = new_node(as_list);
  258.     N_LIST(list_node) = index_list;
  259.     N_LIST(node)      = (Tuple) 0;
  260.     N_KIND(node)      = as_index;
  261.     N_AST1(node)      = object_node ;
  262.     N_AST2(node)      = list_node ;
  263.     N_TYPE(node)      = comp_type;
  264. }
  265.  
  266. /*
  267.  *--------------------------
  268.  * 4.1.3 Selected components
  269.  */
  270.  
  271. Node new_selector_node(Node object_node, Symbol selector) /*;new_selector_node*/
  272. {
  273.     /*
  274.      * The selector  is a declared  component name, or the  internal marker
  275.      * 'constrained' used  to represent the  corresponding attribute.  This
  276.      * name is used for all records with discriminants. Its type is BOOLEAN.
  277.      */
  278.  
  279.     Node    node, sel_node;
  280.  
  281.     node         = new_node(as_selector) ;
  282.     sel_node     = new_name_node(selector) ;
  283.     N_AST1(node) = object_node ;
  284.     N_AST2(node) = sel_node ;
  285.     N_TYPE(node) = TYPE_OF(selector) ;
  286.     return node ;
  287. }
  288.  
  289. void make_selector_node(Node node, Node object_node, Symbol selector)
  290.                                                     /*;make_selector_node*/
  291. {
  292.     /*
  293.      * The selector  is a declared  component name, or the  internal marker
  294.      * 'constrained' used  to represent the  corresponding attribute.  This
  295.      * name is used for all records with discriminants. Its type is BOOLEAN.
  296.      */
  297.  
  298.     Node    sel_node;
  299.  
  300.     sel_node     = new_name_node(selector) ;
  301.     N_KIND(node) = as_selector;
  302.     N_LIST(node) = (Tuple) 0;
  303.     N_AST1(node) = object_node ;
  304.     N_AST2(node) = sel_node ;
  305.     N_TYPE(node) = TYPE_OF(selector) ;
  306. }
  307.  
  308. Node new_discr_ref_node(Symbol d_name, Symbol type_name)    /*;new_discr_ref*/
  309. {
  310.     Node    node;
  311.  
  312.     node         = new_node(as_discr_ref) ;
  313.     N_AST1(node) = new_name_node(type_name);
  314.     N_UNQ(node) = d_name;
  315.     N_TYPE(node) = TYPE_OF(d_name);
  316.     retu